# Entity capabilities support (XEP-0115)

package require sha1
package require md5
package require base64

namespace eval caps {
    set ::NS(caps) http://jabber.org/protocol/caps
    variable hash md5
}

proc caps::hash {identities features {hash sha-1}} {

    set binidentities {}
    foreach id $identities {
	lappend binidentities [encoding convertto utf-8 $id]
    }

    set binfeatures {}
    foreach fe $features {
	lappend binfeatures [encoding convertto utf-8 $fe]
    }

    set binstr [join [concat [lsort -ascii $binidentities] \
			     [lsort -ascii $binfeatures]] "<"]

    if {[string equal $binstr ""]} {
	return ""
    }

    append binstr "<"

    switch -- $hash {
	md5 {
	    if {[catch {::md5::md5 -hex $binstr} hex]} {
		# Old md5 package.
		set hex [::md5::md5 $binstr]
	    }
	    set binhash [binary format H32 $hex]
	}
	sha-1 {
	    set binhash [binary format H40 [::sha1::sha1 $binstr]]
	}
	default {
	    # Unsupported hash type
	    return ""
	}
    }
    return [base64::encode $binhash]
}

proc caps::info_to_hash {child {hash sha-1}} {
    set identities {}
    set features {}

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1
	switch -- $tag1 {
	    identity {
		set category [jlib::wrapper:getattr $vars1 category]
		set type [jlib::wrapper:getattr $vars1 type]
		if {![string equal $category ""] && ![string equal $type ""]} {
		    lappend identities $category/$type
		}
	    }
	    feature {
		set var [jlib::wrapper:getattr $vars1 var]
		if {![string equal $var ""]} {
		    lappend features $var
		}
	    }
	}
    }
    return [hash $identities $features $hash]
}

proc caps::get_presence_x {varname connid status} {
    global tkabber_version
    variable hash
    upvar 2 $varname var

    lassign [disco::info_query_get_handler \
		    $connid "" \
		    [jlib::get_lang] \
		    [jlib::wrapper:createtag query \
			    -vars [list xmlns $::NS(disco_info)]]] \
	    res child

    if {![string equal $res result]} return

    set ver [info_to_hash $child $hash]
    if {[string equal $ver ""]} return

    lappend var [jlib::wrapper:createtag c \
		     -vars [list xmlns $::NS(caps) \
				 hash $hash \
				 node http://code.google.com/p/tkabbur/#$tkabber_version \
				 ver $ver]]
    return
}

hook::add presence_xlist_hook [namespace current]::caps::get_presence_x

# TODO match caps hash to a set of features
proc caps::process_presence {connid from type x args} {
    variable htype
    variable hver

    switch -- $type {
	unavailable {
	    catch {unset htype($connid,$from)}
	    catch {unset hver($connid,$from)}
	}
	available {
	    foreach xs $x {
		jlib::wrapper:splitxml $xs tag vars isempty chdata children
		if {[jlib::wrapper:getattr $vars xmlns] == $::NS(caps)} {
		    set hash [jlib::wrapper:getattr $vars hash]
		    if {[string equal $hash ""]} {
			set hash sha-1
		    }
		    set htype($connid,$from) $hash
		    set hver($connid,$from) [jlib::wrapper:getattr $vars ver]
		    return
		}
	    }
	    # Unset caps if they aren't included in <presence/>
	    catch {unset htype($connid,$from)}
	    catch {unset hver($connid,$from)}
	}
    }
}

hook::add client_presence_hook [namespace current]::caps::process_presence

proc caps::clean {connid} {
    variable htype
    variable hver

    array unset htype $connid,*
    array unset hver $connid,*
}

hook::add disconnected_hook [namespace current]::caps::clean

proc caps::info_receive \
     {connid jid node res identities features extras featured_nodes} {
    variable hidentities
    variable hfeatures
    variable htype
    variable hver

    if {![string equal $res OK]} return
    if {![info exists hver($connid,$jid)]} return

    set ids {}
    foreach id $identities {
	set category [jlib::wrapper:getattr $id category]
	set type [jlib::wrapper:getattr $id type]
	if {![string equal $category ""] && ![string equal $type ""]} {
	    lappend ids $category/$type
	}
    }
    set fes {}
    foreach fe $features {
	set var [jlib::wrapper:getattr $fe var]
	if {![string equal $var ""]} {
	    lappend fes $var
	}
    }
    if {![string equal [hash $ids $fes $htype($connid,$jid)] \
		       $hver($connid,$jid)]} {
	return
    }

    set hidentities($htype($connid,$jid),$hver($connid,$jid)) $ids
    set hfeatures($htype($connid,$jid),$hver($connid,$jid)) $fes
}

hook::add disco_info_hook [namespace current]::caps::info_receive

